{-# LANGUAGE TypeOperators, FlexibleContexts #-}
{- |
Module      :  Loader.Parser
Description :  <optional short text displayed on contents page>
Copyright   :  (c) Sergey Sichevskiy 2012
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable

-}

module Loader.Parser
  ( get
  , parseConfigFile
  , parseTableFile
  , parseArrayFile
  , parseFuncFile
  , parseBFuncFile
  , parsePicklesSpectralSetFile
  , parseCastelliSpectralSetFile
  , parseATLAS9FluxFile
  , parseATLAS9Teff
  , parseATLAS9Logg
  )
    where


import Control.Monad.Reader         ( ReaderT, MonadReader, MonadIO, runReaderT, asks, join, liftIO, lift )
import Control.Monad.Error          ( MonadError, throwError, strMsg )
import Control.Monad.List           ( ListT(..), runListT )

import Data.Array                   ( Array, array )
import Data.ConfigFile              ( emptyCP, readfile, ConfigParser(..), SectionSpec, OptionSpec, Get_C )
import Data.BFunction               ( (:~>:)(..) )

import Loader.Parser.Error          ( SCPError(..) )
import Loader.TableParser hiding    ( get )

import Text.Scanf

import qualified Data.Text.IO       as TIO
import qualified Data.ConfigFile    as CF
import qualified Loader.TableParser as T
import qualified Interpolation      as I


-- |Анализатор файла конфигурации. Файл конфигурации - это  INI-подобный файл,
-- но с некоторым количеством улучшений.
parseConfigFile :: (MonadError SCPError m, MonadIO m) => FilePath -> ReaderT (ConfigParser, FilePath) m a -> m a
parseConfigFile fn p = do
   let cp = emptyCP {optionxform = map id}
   cp' <- join $ liftIO $ readfile cp fn >>= return . either (throwError . CPError fn) (return)
   runReaderT p (cp',fn)

-- |Извлекает информацию из строки в конфигурационном файле.
-- Может применяться в парсере анализатора parseConfigFile.
get :: (Show a, Get_C a, MonadReader (ConfigParser, FilePath) m, MonadError SCPError m, MonadIO m) => SectionSpec -> OptionSpec -> m a
get s o = do
  cp <- asks $ fst
  fn <- asks $ snd
  liftIO $ putStr $ s ++"::"++ o ++ " = "
  v <- either (throwError . CPError fn) (return) $ CF.get cp s o
  liftIO $ putStr $ (show v) ++ "\n"
  return v

-- |Анализатор файла с данными представленными в виде таблицы, в котором имеется
-- описательная (конфигурационная) часть, расположенная перед таблицей.
parseTableFile :: (MonadIO m, MonadError SCPError m) => ReaderT TableConfigParser (Either TPError) (Parser a) -> ((ConfigParser, [a]) -> Either TPError b) -> FilePath -> m b
parseTableFile contentParser postParser fname = do
   s <- liftIO $ TIO.readFile fname
   let m = readTableWithConfig s contentParser >>= postParser
   either (throwError.TPError fname) (return) m

-- |Анализатор, построенный на основе parseTableFile. Извлекает информацию
-- из файла и преобразует ее в 2-ух мерный массив. Количество элементов
-- массива определяется в конфигурационной части анализируемого файла.
parseArrayFile :: (MonadIO m, MonadError SCPError m) => ReaderT TableConfigParser (Either TPError) (Parser [e]) -> FilePath -> m (Array (Int, Int) e)
parseArrayFile contentParser = parseTableFile contentParser postParser
   where
      postParser (cp,t) = do
           (l,r) <- T.get cp "DEFAULT" "Bounds"

           case (indexS l r t) of
                 Just a  -> return $ array (l,r) a
                 Nothing -> throwError $ strMsg "It is epic fail!!!"
         where
            indexS :: (Int,Int) -> (Int,Int)-> [[a]] -> Maybe [((Int,Int),a)]
            indexS (l,l') (r,r') xs  = runListT $ do
                                                    (i, ys) <- ListT $ zipS [l .. r ] xs
                                                    (j,  x) <- ListT $ zipS [l'.. r'] ys
                                                    return ((i,j), x)

            zipS :: [a] -> [b] -> Maybe [(a,b)]
            zipS [] [] = Just []
            zipS (x:xs) (y:ys) = do
                                   r <- zipS xs ys
                                   return $ (x,y) : r
            zipS _ _ = Nothing

-- |Анализатор, построенный на основе parseTableFile. Извлекает информацию из файла и
-- с помощью линейной интерполяции преобразует ее в функцию.  Границы области определения
-- и шаг семплирования определяется в конфигурационной части анализируемого файла.
parseFuncFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (Double -> Double)
parseFuncFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         x <- double
         y <- double
         return (x,y)
      pParser (cp, t) = do
         b <- T.get cp "DEFAULT" "Bounds"
         h <- T.get cp "DEFAULT" "Step"
         return $ I.linearSamplingU b h t

-- Анализатор, построенный на основе parseTableFile. Извлекает информацию из файла и
-- с помощью линейной интерполяции преобразует ее в функцию.  Границы области определения
-- и шаг семплирования определяется в конфигурационной части анализируемого файла.
parseBFuncFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (Double :~>: Double)
parseBFuncFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         x <- double
         y <- double
         return (x,y)
      pParser (cp, t) = do
         b <- T.get cp "DEFAULT" "Bounds"
         h <- T.get cp "DEFAULT" "Step"

         let f = I.linearSamplingU b h t

         return $ F b f

--parseSpectralSetFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (Double :~>: Double)
parsePicklesSpectralSetFile :: (MonadIO m, MonadError SCPError m, Get t) => FilePath -> m (t, [(Double, Double, [Char])])
parsePicklesSpectralSetFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         i  <- double
         skip
         m  <- double
         fn <- string
         return (i,m,fn)
      pParser (cp, t) = do
         g <- T.get cp "DEFAULT" "Grid"
         p <- T.get cp "DEFAULT" "Path"

         let f (i,m,fn) = ( i, m, p++"/"++fn )

         return (g, map f t)

parseCastelliSpectralSetFile :: (MonadIO m, MonadError SCPError m, Get a, Get b) => FilePath -> m (a, b, [(Double, String)])
parseCastelliSpectralSetFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         i  <- double
         fn <- string
         return (i,fn)
      pParser (cp, t) = do
         b <- T.get cp "DEFAULT" "Bounds"
         h <- T.get cp "DEFAULT" "Step"

         return $ (b,h,t)

parseATLAS9FluxFile :: (MonadIO m, MonadError SCPError m) => FilePath -> m (Double :~>: Double)
parseATLAS9FluxFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         x  <- double
         y  <- double

         let c = 299792458 * 1E10
             l = x 
             f = 4  * y * c / l**2
         return (l,f)
      pParser (cp, t) = do
         b <- T.get cp "DEFAULT" "Bounds"
         h <- T.get cp "DEFAULT" "Step"

         let f = I.linearSamplingU b h t

         return $ F b f

parseATLAS9Logg :: (MonadIO m, MonadError SCPError m, Get t) => FilePath -> m (t, [(Double, [Char])])
parseATLAS9Logg = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         x  <- double
         y  <- string

         return (x,y)

      pParser (cp, t) = do
         g <- T.get cp "DEFAULT" "Grid"
         p <- T.get cp "DEFAULT" "Path"

         let f (x,y) = ( x, p++"/"++y )

         return (g, map f t)

parseATLAS9Teff :: (MonadIO m, MonadError SCPError m, Get t) => FilePath -> m (t, [(Double, [Char])])
parseATLAS9Teff = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         x  <- double
         y  <- string

         return (x,y)

      pParser (cp, t) = do
         g <- T.get cp "DEFAULT" "Grid"
         p <- T.get cp "DEFAULT" "Path"

         let f (x,y) = ( x, p++"/"++y )

         return (g, map f t)
